home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 November: Tool Chest / Dev.CD Nov 94.toast / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / AppleScript-from-lisp / AppleScript Editor.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  8.9 KB  |  261 lines  |  [TEXT/CCL2]
  1. ;;;-*- Mode: Lisp; Package: COMMON-LISP-USER -*-
  2.  
  3. (in-package :cl-user)
  4.  
  5. ;; file:  applescript-editor.lisp
  6.  
  7.  
  8. ;;    Author T. Bonura, 1994
  9. ;;    ©Apple Computer
  10. ;;  an applescript editor (duhh)
  11. ;;  TO DO:
  12. ;;  Need to check to insure that if the contents of the buffer have changed,
  13. ;;  before closing the editor, the applescript object gets the new changes - no
  14. ;;  big deal right now.
  15.  
  16. (require :scrolling-fred-dialog-item)
  17.  
  18. (DEFMACRO MAKE-LITERAL-STRING (string)
  19.   ;;takes a string and string quotes it. e.g. "foo" ->
  20.   ;;           "\"foo\""
  21.   `(concatenate 'string "\"" ,string "\""))
  22.  
  23. (DEFUN NULL-STRING-P (STRING)
  24.   "Return t if the string is "" otherwise nil"
  25.   (IF (NOT (STRINGP string))
  26.       (ERROR nil (FORMAT nil "The arg to null-string-p, ~a, is not a string.~%" string))
  27.       (IF (EQ (LENGTH string) 0)
  28.       t
  29.       nil)))
  30. (DEFVAR *AS-SCRIPT-EDITOR* NIL "Points to the applescript editor")
  31. (DEFVAR *BOGUS-SCRIPT* 
  32.   (concatenate 'string "tell application " (make-literal-string "applicationName")
  33.                (format nil "~%") (format nil "~%") 
  34.                "end tell" (format nil "~%"))
  35.   )
  36.  
  37. ;;  THis is where the script is actually written
  38. (DEFCLASS AS-INPUT-BUFFER (ccl::scrolling-fred-dialog-item)
  39.   ()
  40.   (:default-initargs 
  41.     :view-size #@(450 230)
  42.     :view-nick-name 'input-buffer
  43.     )
  44.   )
  45.  
  46. (DEFCLASS AS-EDITOR-WINDOW (window)
  47.   ((current.object :initarg :current-object :initform nil :accessor current-object)
  48.    )
  49.   (:default-initargs
  50.     :window-type :document-with-grow
  51.     :color-p t
  52.     :window-title "AppleScript Editor"
  53.     :view-position #@(50 100)
  54.     :view-size #@(500 300)
  55.     :close-box-p t
  56.     )
  57.   )
  58.  
  59. (DEFCLASS RUN-SCRIPT-BTN (ccl::button-dialog-item)
  60.   ()
  61.   (:default-initargs
  62.     :view-nick-name 'run-btn
  63.     :default-button nil
  64.     :dialog-item-text "Run Script"
  65.     :view-size #@(100 20)
  66.     :view-position #@(79 274)
  67.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  68.     )
  69.   )
  70.  
  71. (DEFMETHOD DIALOG-ITEM-ACTION ((btn run-script-btn))
  72.   ;;  enter the script into the applescript instance then compile and run the script.
  73.   (let* ((dialog (view-container btn))
  74.          (as-object (current-object dialog))
  75.          (script (extract-script-text (dialog-item-text (view-named 'input-buffer dialog)))))
  76.     ; set the script
  77.     (setf (script as-object) script)
  78.     (open-component as-object)
  79.     (compile-applescript as-object)
  80.     (execute-applescript as-object)
  81.     (if (check-box-checked-p (view-named 'show-result (view-container btn)))
  82.       (format t "~a~%" (show-result-as-string as-object)))
  83.     )
  84.   )
  85.  
  86. (DEFCLASS ADD-SCRIPT-BTN (button-dialog-item)
  87.   ()
  88.   (:default-initargs
  89.     :view-nick-name 'add-btn
  90.     :default-button t
  91.     :dialog-item-text "Set Script"
  92.     :view-size #@(100 20)
  93.     :view-position #@(183 273)
  94.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  95.     )
  96.   )
  97.  
  98. (DEFMETHOD DIALOG-ITEM-ACTION ((btn add-script-btn))
  99.   ;;  enter the script into the applescript instance then compile it.
  100.   (let* ((dialog (view-container btn))
  101.          (as-object (current-object dialog))
  102.          (script (dialog-item-text (view-named 'input-buffer dialog))))
  103.     ; set the script
  104.     (setf (script as-object) script)
  105.     ;; since we want to recompile the script set the compiled script id to nil
  106.     (setf (compiled-script-id as-object) nil)
  107.     ))
  108.  
  109. (DEFCLASS CANCEL-BTN (button-dialog-item)
  110.   ()
  111.   (:default-initargs
  112.     :view-nick-name 'cancel-btn
  113.     :default-button nil
  114.     :dialog-item-text "cancel"
  115.     :view-size #@(60 20)
  116.     :view-position #@(301 275)
  117.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  118.     )
  119.   )
  120.  
  121. (DEFMETHOD DIALOG-ITEM-ACTION ((btn cancel-btn))
  122.   ;;  punt
  123.   (let ((dialog (view-container btn)))
  124.     ; set the script
  125.     (set-dialog-item-text (view-named 'input-buffer dialog) "")
  126.     (setf (current-object dialog) nil)
  127.     ))
  128.  
  129.  
  130. (DEFMETHOD SHOW-SCRIPT ((window AS-EDITOR-WINDOW) &optional (script *bogus-script*))
  131.   ;;  shove the script in the AS-INPUT-BUFFER
  132.   (let ((input.buffer (view-named 'input-buffer window)))
  133.     (set-dialog-item-text input.buffer script)
  134.     )
  135.   )
  136.  
  137. (DEFUN MAKE-APPLESCRIPT-EDITOR (&optional as-object)
  138.   (cond ((and *AS-SCRIPT-EDITOR*
  139.               (wptr *AS-SCRIPT-EDITOR*))
  140.          (window-select *AS-SCRIPT-EDITOR*)
  141.          (setf (current-object *AS-SCRIPT-EDITOR*) as-object)
  142.          )
  143.         (t
  144.          (setf *AS-SCRIPT-EDITOR*
  145.                (make-instance 'as-editor-window))
  146.          (setf (current-object *AS-SCRIPT-EDITOR*) as-object)
  147.          (let* ((v-offset 20)
  148.                 (h-offset 15)
  149.                 (dialog-size (view-size *AS-SCRIPT-EDITOR*))
  150.                 (dialog-width (point-h dialog-size))
  151.                 (dialog-height (point-v dialog-size))
  152.                 (reserve-for-button 50)
  153.                 (button-margin (floor
  154.                                 (/ (- (point-h dialog-width)
  155.                                       280 ;sum of buttons
  156.                                       ) 2)))
  157.                 (run-button-position nil)
  158.                 (add-button-position nil)
  159.                 (cancel-button-position nil))
  160.            (setf run-button-position
  161.                  (make-point button-margin 
  162.                              (- dialog-height 25)))
  163.            (setf add-button-position 
  164.                  (make-point (+ 10 (point-h run-button-position)
  165.                                 100)
  166.                              (point-v run-button-position)))
  167.            (setf cancel-button-position
  168.                  (make-point (+ 10 (point-h add-button-position) 100)
  169.                              (point-v run-button-position)))
  170.            (add-subviews *AS-SCRIPT-EDITOR*
  171.                          (make-instance 'check-box-dialog-item
  172.                            :view-position #@(0 0)
  173.                            :dialog-item-text "Show The Result?"
  174.                            :check-box-checked-p t
  175.                            :view-nick-name 'show-result)
  176.                          (make-instance 'as-input-buffer
  177.                            :view-position (make-point 0 v-offset)
  178.                            :view-size (make-point 
  179.                                        (- dialog-width
  180.                                           h-offset)
  181.                                        (- dialog-height
  182.                                           v-offset
  183.                                           reserve-for-button)))
  184.                            (make-instance 'run-script-btn
  185.                              :view-position run-button-position)
  186.                            (make-instance 'add-script-btn
  187.                              :view-position add-button-position)
  188.                            (make-instance 'cancel-btn
  189.                              :view-position cancel-button-position)))))
  190.         )
  191.   
  192. ;;(make-applescript-editor)
  193.  
  194. (defmethod ccl::set-view-size ((window AS-EDITOR-WINDOW) h &optional v)
  195.   ;;  do the regular thing
  196.   (declare (ignore v))
  197.   (call-next-method)
  198.   ;;  resize the input-buffer proportionally
  199.   
  200.   (let* ((v-offset 20)
  201.          (h-offset 15)
  202.          (dialog-width (point-h h))
  203.          (dialog-height (point-v h))
  204.          (reserve-for-button 50)
  205.          (button-margin (floor
  206.                          (/ (- dialog-width
  207.                                280 ;sum of buttons
  208.                                ) 2)))
  209.          (run-button-position nil)
  210.          (add-button-position nil)
  211.          (cancel-button-position nil))
  212.     (setf run-button-position
  213.           (make-point button-margin 
  214.                       (- dialog-height 25)))
  215.     (setf add-button-position 
  216.           (make-point (+ 10 (point-h run-button-position)
  217.                          100)
  218.                       (point-v run-button-position)))
  219.     (setf cancel-button-position
  220.           (make-point (+ 10 (point-h add-button-position) 100)
  221.                       (point-v run-button-position)))
  222.     (set-view-size (view-named 'input-buffer window) 
  223.                    (- dialog-width h-offset)
  224.                    (- dialog-height  v-offset  reserve-for-button))
  225.     (set-view-position (view-named 'run-btn window) (point-h run-button-position)
  226.                    (point-v run-button-position))
  227.     (set-view-position (view-named 'add-btn window) (point-h add-button-position)
  228.                    (point-v add-button-position))
  229.     (set-view-position (view-named 'cancel-btn window) (point-h cancel-button-position)
  230.                    (point-v cancel-button-position))
  231.     )
  232.   )
  233.  
  234. ;; Method for editing scripts using the applescript-editor
  235.  
  236. (DEFMETHOD EDIT-SCRIPT ((ASO APPLESCRIPT-OBJECT))
  237.   (declare (special  *AS-SCRIPT-EDITOR*))
  238.   (let ((script (script ASO))
  239.         (theApp (application-name ASO)))
  240.     (if (and script
  241.              (not (null-string-p script)))
  242.       (progn
  243.         (make-applescript-editor ASO)
  244.         (show-script *AS-SCRIPT-EDITOR* script))
  245.       (progn
  246.         (make-applescript-editor ASO) 
  247.         (if theApp
  248.           (show-script *AS-SCRIPT-EDITOR* 
  249.                        (concatenate 'string "tell application"
  250.                                    (make-literal-string theApp)
  251.                                    " to")))))
  252.     )
  253.   )
  254.  
  255.  
  256.  
  257.  
  258. (provide :as-edit)
  259.  
  260.  
  261.